home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
19
/
window.zip
/
WINDOW32.INC
< prev
next >
Wrap
Text File
|
1987-02-20
|
14KB
|
302 lines
{ =========================================================================== }
{ Window32.inc - Multi-level windowing routines ver 3.2, 02-20-87 }
{ }
{ This file allows you to produce quick multi-level windows for IBM PC/XT/AT }
{ compatibles in any column mode (40/80/etc.). You should get a copy of }
{ QWIK21.ARC or a later version to make full use of quick screen writing }
{ utilites. This file has been released under the free Teamware concept. }
{ Editor: Jim H. LeMay (Author of QWIK21.INC and editor of this file) }
{ Author: Michael Burton (Original author of WINDO.INC version 2.3) }
{ =========================================================================== }
type
Borders = (NoBrdr, BlankBrdr, SingleBrdr, DoubleBrdr, MixedBrdr, SolidBrdr,
EvenSolidBrdr, ThinSolidBrdr, LhatchBrdr, MhatchBrdr,
HhatchBrdr, UserBrdr);
BrdrRec = record
TL,TH,TR,LV,RV,BL,BH,BR: string[1];
end;
DirType = (NoDir,Up,Down,VeryTop,Top,Bottom,VeryBottom,FarLeft,Left,Right,
FarRight,Center);
WndwStatType = record
WSrow,WScol,WSrows,WScols,WSWattr,WSBattr: byte;
WSbrdr: Borders;
WSshadow: DirType;
WSlastx,WSlasty: byte;
end;
BytePtr = ^byte;
Str160 = String[160];
{ The following constants are typed so there's no need to change this file. }
{ Just assign them new values in your main program like any other variable. }
{ UserBrdr is also one you can use for scratch while keeping the others. }
const
Brdr: array [BlankBrdr..UserBrdr] of BrdrRec =
((TL:' ';TH:' ';TR:' ';LV:' ';RV:' ';BL:' ';BH:' ';BR:' '), { Blank }
(TL:'┌';TH:'─';TR:'┐';LV:'│';RV:'│';BL:'└';BH:'─';BR:'┘'), { Single }
(TL:'╔';TH:'═';TR:'╗';LV:'║';RV:'║';BL:'╚';BH:'═';BR:'╝'), { Double }
(TL:'╒';TH:'═';TR:'╕';LV:'│';RV:'│';BL:'╘';BH:'═';BR:'╛'), { Mixed }
(TL:'█';TH:'█';TR:'█';LV:'█';RV:'█';BL:'█';BH:'█';BR:'█'), { Solid }
(TL:'█';TH:'▀';TR:'█';LV:'█';RV:'█';BL:'█';BH:'▄';BR:'█'), { EvenSolid }
(TL:'▐';TH:'▀';TR:'▌';LV:'▐';RV:'▌';BL:'▐';BH:'▄';BR:'▌'), { ThinSolid }
(TL:'░';TH:'░';TR:'░';LV:'░';RV:'░';BL:'░';BH:'░';BR:'░'), { Lhatch }
(TL:'▒';TH:'▒';TR:'▒';LV:'▒';RV:'▒';BL:'▒';BH:'▒';BR:'▒'), { Mhatch }
(TL:'▓';TH:'▓';TR:'▓';LV:'▓';RV:'▓';BL:'▓';BH:'▓';BR:'▓'), { Hhatch }
(TL:' ';TH:' ';TR:' ';LV:' ';RV:' ';BL:' ';BH:' ';BR:' ')); { User }
ShadowEffect: DirType = NoDir;
ZoomEffect: boolean = false;
ZoomDelay: byte = 11;
var
WndwStat : Array [0..MaxWndw] of WndwStatType; { window stats }
WndwPtr : Array [1..MaxWndw] of BytePtr; { pointer to window on heap }
LI : byte; { level index }
Tattr: byte absolute Dseg:$0008; { Turbo's attribute value }
{ =========================================================================== }
{ NAME: Attr ver 3.1, 02-11-87 }
{ DESCRIPTION: Converts Turbo color constants into an attribute }
{ and masks any accidental blink bit. }
{ PARAMETERS: ForeGround - Color of text foreground }
{ BackGround - Color of text background }
{ =========================================================================== }
function Attr (Foreground,Background: byte): byte;
begin
Attr := ((BackGround shl 4) + ForeGround) and 127;
end;
{ =========================================================================== }
{ NAME: Qbox ver 3.1, 02-11-87 }
{ DESCRIPTION: Writes a window with optional border. Since attribute }
{ is byte, the colors should always be specified. }
{ PARAMETERS: See QWIK21.DOC }
{ =========================================================================== }
procedure Qbox (Row,Col,Rows,Cols,WndwAttr,BrdrAttr: byte; BrdrSel: Borders);
begin
if (Rows>=2) and (Cols>=2) then
begin
if BrdrSel<>NoBrdr then
with Brdr[BrdrSel] do
begin
QwriteV (Row ,Col ,BrdrAttr,TL);
Qfill (Row ,Col+1 ,1 ,Cols-2,BrdrAttr,TH);
QwriteV (Row ,Col+Cols-1 ,BrdrAttr,TR);
Qfill (Row+1 ,Col ,Rows-2,1 ,BrdrAttr,LV);
Qfill (Row+1 ,Col+Cols-1,Rows-2,1 ,BrdrAttr,RV);
QwriteV (Row+Rows-1,Col ,BrdrAttr,BL);
Qfill (Row+Rows-1,Col+1 ,1 ,Cols-2,BrdrAttr,BH);
QwriteV (Row+Rows-1,Col+Cols-1 ,BrdrAttr,BR);
Qfill (Row+1 ,Col+1 ,Rows-2,Cols-2,WndwAttr,' ')
end
else Qfill (Row,Col,Rows,Cols,WndwAttr,' ');
end
end;
{ =========================================================================== }
{ NAME: InitWindow ver 3.1, 02-11-87 }
{ DESCRIPTION: Initializes the window variables. Use this routine before }
{ using MakeWindow, RemoveWindow or TitleWindow }
{ PARAMETERS: }
{ Wattr - Starting window attribute }
{ =========================================================================== }
procedure InitWindow (Wattr: byte);
begin
Qinit; { QWIK21.INC initialization !!!! }
Tattr := Wattr;
LI := 0;
with WndwStat[LI] do
begin
WSrow := 1; { Initialize non-window zero }
WScol := 1;
WSrows := 25;
WScols := 80;
WSWattr := Wattr;
WSBattr := Wattr;
WSbrdr := NoBrdr;
WSlastx := WhereX;
WSlasty := WhereY
end;
Qfill ( 1, 1,25,80,Wattr,' ')
end;
{ =========================================================================== }
{ NAME: MakeWindow ver 3.2, 02-20-87 }
{ DESCRIPTION: Creates a window on your screen. }
{ PARAMETERS: }
{ Row - First row (1 - Screen limit) }
{ Col - First column (1 - Screen limit) }
{ Rows - # of rows (1 - Screen limit) }
{ Cols - # of columns (1 - Screen limit) }
{ Wattr - Window attribute (0 - 255) }
{ Battr - Border attribute (0 - 255) }
{ BrdSel - Border selection (NoBrdr - UserBrdr) }
{ =========================================================================== }
procedure MakeWindow (Row,Col,Rows,Cols,Wattr,Battr: byte; BrdrSel: Borders);
var wsize,r1,r2,c1,c2,ColRatio: integer;
begin
if LI>=MaxWndw then WriteLn(^G^G,'Too many Windows!')
else
begin
case ShadowEffect of
Left: begin
c1:=Col-2; c2:=Cols+2; r2:=Rows+1
end;
Right: begin
c1:=Col; c2:=Cols+2; r2:=Rows+1
end;
else begin
c1:=Col; c2:=Cols; r2:=Rows;
end;
end;
wsize := r2*c2 shl 1; { Memory size needed to store display }
if (0<memavail) and (memavail<=(wsize shr 4)) then
WriteLn(^G^G,'Not enough Heap space!')
{ if memavail<0 then there's plenty of room (>512kb) }
else
begin
WndwStat[LI].WSlastx := Wherex; { Store old cursor coordinates }
WndwStat[LI].WSlasty := Wherey;
LI := LI+1; { Go to next window level }
Tattr := Wattr;
with WndwStat[LI] do
begin
WSrow := Row; { Store all variables for this window }
WScol := Col;
WSrows := Rows;
WScols := Cols;
WSWattr := Wattr;
WSBattr := Battr;
WSbrdr := BrdrSel;
WSshadow:= ShadowEffect
end;
GetMem (WndwPtr[LI],wsize); { Get enough heap to store old display }
QstoreToMem (Row,c1,r2,c2,WndwPtr[LI]^);
if ZoomEffect then
begin
r1 := row+ (rows shr 1);
r2 := row+rows-(rows shr 1);
c1 := col+ (cols shr 1);
c2 := col+cols-(cols shr 1);
ColRatio := (cols div rows)+1;
if ColRatio>4 then ColRatio:=4;
repeat
if r1>row then r1:=r1-1;
if r2<(row+rows) then r2:=r2+1;
if c1>col then c1:=c1-ColRatio;
if c1<col then c1:=col;
if c2<(col+cols) then c2:=c2+ColRatio;
if c2>(col+cols) then c2:=col+cols;
Qbox (r1,c1,r2-r1,c2-c1,Tattr,Battr,BrdrSel);
if Qwait=false then delay (ZoomDelay);
until (c1=col) and (c2=col+cols) and (r1=row) and (r2=row+rows)
end
else Qbox (Row,Col,Rows,Cols,Wattr,Battr,BrdrSel);
case ShadowEffect of
Left: begin
Qfill (Row+1 ,Col-2,Rows-1,2 ,0,' ');
Qfill (Row+Rows,Col-2,1 ,Cols,0,' ')
end;
Right: begin
Qfill (Row+1 ,Col+Cols,Rows-1,2 ,0,' ');
Qfill (Row+Rows,Col+2 ,1 ,Cols,0,' ')
end;
end;
if BrdrSel=NoBrdr then
Window (Col ,Row ,Col+Cols-1,Row+Rows-1)
else Window (Col+1,Row+1,Col+Cols-2,Row+Rows-2);
GotoXY (1,1)
end
end
end;
{ =========================================================================== }
{ NAME: RemoveWindow ver 3.1, 02-11-87 }
{ DESCRIPTION: Remove the last window created from the screen. To }
{ get back to the original screen, there must be as many }
{ RemoveWindow(s) as there are MakeWindow(s). }
{ =========================================================================== }
procedure RemoveWindow;
var wsize,r1,r2,c1,c2: integer;
begin
if LI=0 then WriteLn (^G^G,'No Window To Remove!')
else
begin
with WndwStat[LI] do
begin
case WSshadow of
Left: begin
c1:=WScol-2; c2:=WScols+2; r2:=WSrows+1
end;
Right: begin
c1:=WScol; c2:=WScols+2; r2:=WSrows+1
end;
else begin
c1:=WScol; c2:=WScols; r2:=WSrows;
end;
end;
wsize := r2*c2 shl 1; { Memory size needed to restore display }
QstoreToScr (WSrow,c1,r2,c2,WndwPtr[LI]^);
FreeMem (WndwPtr[LI],wsize);
end;
LI := LI - 1; { Go to next lower level }
with WndwStat[LI] do
begin
Tattr:= WSWattr;
if WSbrdr=NoBrdr then
Window (WScol ,WSrow ,WScol+WScols-1,WSrow+WSrows-1)
else Window (WScol+1,WSrow+1,WScol+WScols-2,WSrow+WSrows-2);
GotoXY (WSlastx,WSlasty)
end
end
end;
{ =========================================================================== }
{ NAME: TitleWindow ver 3.1, 02-11-87 }
{ DESCRIPTION: Places a centered title in the top border of a window }
{ PARAMETERS: Justify - justification of the title }
{ Title - Optional title of the window }
{ =========================================================================== }
procedure TitleWindow (Justify: DirType; title: Str160);
begin
with WndwStat[LI] do
case Justify of
Left : QwriteV (WSrow,WScol+2, -1,title);
Center : QwriteCV (WSrow,WScol,WScol+WScols-1, -1,title);
Right : QwriteV (WSrow,WScol+WScols-Length(Title)-2, -1,title);
end;
end;
{ =========================================================================== }
{ NAME: ScrollWindow ver 3.2, 02-20-87 }
{ DESCRIPTION: Scrolls a number of rows in a window. Using a little }
{ thought, you can see how this is better than the InsLine }
{ and DelLine procedures. This also works on any page. }
{ PARAMETERS: RowBegin,RowEnd - Rows to be affected }
{ Dir - 'Up' or 'Down' }
{ =========================================================================== }
procedure ScrollWindow (RowBegin,RowEnd: byte; Dir: DirType);
var BrdrWidth,R,C,Rs,Cs: byte;
{}procedure Qscroll (MemRowBegin,ScrRowBegin,FillRow: byte);
var Temp: array[1..14000] of byte; { large enough for 132x50 }
begin
QstoreToMem (MemRowBegin,C,Rs,Cs,Temp);
QstoreToScr (ScrRowBegin,C,Rs,Cs,Temp);
Qfill (FillRow ,C, 1,Cs,WndwStat[LI].WSWattr,' ')
{}end;
begin
with WndwStat[LI] do
begin
if WSbrdr=NoBrdr then
BrdrWidth:=0
else BrdrWidth:=1;
R := WSrow+BrdrWidth+RowBegin-1;
C := WScol+BrdrWidth;
Rs := RowEnd-RowBegin;
Cs := WScols-(BrdrWidth shl 1);
case Dir of
Up: Qscroll (R+1,R ,R+Rs);
Down: Qscroll (R ,R+1,R );
end
end
end;